perm filename USCSUB.SAI[DOC,TOB] blob
sn#227005 filedate 1976-07-20 generic text, type T, neo UTF8
00100 comment convert usc format to su format files;
00200 BEGIN "USC TO SU"
00300
00400 EXTERNAL PROCEDURE BAIL;
00500
00600 REQUIRE "ABBREV.1D[S1,TOB]" SOURCE_FILE;
00700 REQUIRE "STD.12H[S1,TOB]" SOURCE_FILE;
00800 REQUIRE "STD[S1,TOB]" LOAD_MODULE;
00900
01000 REQUIRE "FILEIO.2E[S2,TOB]" SOURCE_FILE;
01100 REQUIRE "FILEIO[S2,TOB]" LOAD_MODULE;
01200
00100
00200 RECORD_POINTER (IO) IFILE; comment input file, channel,etc;
00300 RECORD_POINTER (IO) OFILE; comment output file,channel,etc;
00400 STRING NAME; comment file name;
00500 BAIL;
00600 END "USC TO SU";
00700 IFCR 0 THENC
00800 NAME←ASK_STRING(CRLF&"FILE NAME ");
00900 NEWFILE(IFILE,NAME,"USC","PIC,HE");
01000 OPEN_I(IFILE,BINARY_FILE);
01100 NEWFILE(OFILE,NAME,"SU","PIC,HE");
01200 OPEN_O(OFILE,BINARY_FILE);
01300 BEGIN "HEADER"
01400 INTEGER UNPACKED; comment nonzero if file is unpacked;
01500 INTEGER BITS,BYTES;
01600 INTEGER X1,Y1,X2,Y2;
01700 INTEGER WDS_LINE,SIZE_FILE;
01800 INTEGER I;
01900 BITS←8;
02000 X1←Y1←1;
02100 X2←Y2←512;
02200 WRITE(BITS);WRITE(X1);WRITE(X2);WRITE(Y1);WRITE(Y2);
02300 MODIFY(X2);
02400 PRINT(CRLF,"USC files are usually packed 4 bytes per word.");
02500 PRINT(CRLF,"If unpacked, two bytes per word.");
02600 UNPACKED←YES(CRLF&"Is this unpackedα);
02700 WORDOUT(IO:CH[OFILE],-1); comment first word identifier;
02800 WORDOUT(IO:CH[OFILE],BITS);comment number of bits;
02900 BYTES←WORD_SIZE%BITS;comment bytes per word;
03000 WDS_LINE←(X2-X1+BYTES)%BYTES;
03100 WORDOUT(IO:CH[OFILE],WDS_LINE);
03200 WORDOUT(IO:CH[OFILE],Y1);
03300 WORDOUT(IO:CH[OFILE],Y2);
03400 WORDOUT(IO:CH[OFILE],X1);
03500 WORDOUT(IO:CH[OFILE],X2);
03600 SIZE_FILE←WDS_LINE*(Y2-Y1+1);
03700 WORDOUT(IO:CH[OFILE],XWD(-SIZE_FILE,'200));
03800 FOR I←1 STEP 1 UNTIL 3 DO WORDOUT(IO:CH[OFILE],0);
03900 FOR I←'13 STEP 1 UNTIL '177 DO WORDOUT(IO:CH[OFILE],0);
04000 IF ¬UNPACKED THEN
04100 INOUT(IO:CH[IFILE],IO:CH[OFILE],SIZE_FILE);
04200 IF UNPACKED THEN BEGIN "PACKW"
04300 INTEGER X,Y; comment indices;
04400 FOR Y←Y1 STEP 1 UNTIL Y2 DO BEGIN "ROW"
04500 FOR X←X1 STEP 4 UNTIL X2 DO BEGIN "COLUMN"
04600 INTEGER W; comment input word;
04700 INTEGER WO; comment packed output word;
04800
04900 W←WORDIN(IO:CH[IFILE]);
05000 comment get the first two bytes w=0,b1,0,b2,0;
05100 WO←((W LAND 001774000000) LSH 8)
05200 +((W LAND 000003770000) LSH 16);
05300 W←WORDIN(IO:CH[IFILE]);
05400 comment get the next two bytes w=0,b3,0,b4,0;
05500 WO←WO+((W LAND 001774000000) LSH -8)
05600 +((W LAND 000003770000);
05700 WORDOUT(IO:CH[OFILE],WO);
05800 END "COLUMN";
05900 END "ROW";
06000 END "PACKW";
06100 CLOSE(IO:CH[OFILE]);
06200 END "USC TO SU";
06300 ENDC;